perm filename FLIPS.SAI[4,ALS] blob
sn#056498 filedate 1973-08-02 generic text, type T, neo UTF8
00010 BEGIN "FLIPS"
00020 INTEGER I,J,K,L,M,N,P,Q,POINTX,STATE,DELTA,VAL,CHAN1,EOF;
00030 INTEGER ARRAY BUF,FLOPS[0:1000];
00040 STRING FILEN,READ;
00050 DEFINE CR="'15",LF="'12",TB="'11",CRLF="CR&LF";
00060
00070 FILEN←"FLTD.001[DAT,NJM]";
00080 OUTSTR("Type file name (CR for "&FILEN&".");
00090 IF (READ←INCHWL)≠"" THEN FILEN←READ;
00100 OUTSTR("Specify DELTA (CR for 5) ");
00110 IF (READ←INCHWL)="" THEN DELTA←5 ELSE DELTA←CVD(READ);
00120 CHAN1←1; CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00130 LOOKUP(CHAN1,FILEN,0);
00140 J←K←L←STATE←VAL←0;
00160 OUTSTR(CRLF&"Frication measure on file "&FILEN
00170 &" with DELTA set at "&CVS(DELTA)&CRLF&LF&TB);
00180 SETFORMAT(6,0);
00185 FOR I←0 STEP 1 UNTIL 9 DO OUTSTR(CVS(I)); OUTSTR(CRLF&LF);
00187 Q←0; OUTSTR(CVS(Q)&TB);
00190 WHILE TRUE DO BEGIN
00200 IF EOF≠0 THEN DONE;
00210 FOR J←0 STEP 1 UNTIL 1000 DO BUF[J]←0;
00220 ARRYIN(CHAN1,BUF[0],1000);
00230 POINTX←POINT(12,BUF[0],-1);
00240 FOR I←0 STEP 1 UNTIL 9 DO BEGIN
00250 FOR J←0 STEP 1 UNTIL 99 DO BEGIN
00260 VAL←ILDB(POINTX);
00270 IF STATE=0 THEN
00280 IF VAL>K-DELTA THEN L←L+1 ELSE BEGIN
00290 M←(M*15+L) LSH -4;L←0; STATE←-1; END ELSE
00300
00310 IF VAL<K+DELTA THEN L←L+1 ELSE BEGIN
00320 M←(M*15+L) LSH -4; L←0; STATE←0; END;
00330 K←L;
00340 END;
00350 IF M≤15 THEN FLOPS[I]←M ELSE FLOPS[I]←15;
00360 OUTSTR(CVS(M)); IF (P MOD 10)=9 THEN BEGIN Q←Q+10;
00370 OUTSTR(CRLF&CVS(Q)&TB); P←0; END ELSE P←P+1;
00380 END;
00390 END;
00400
00410 END "FLIPS";